home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch14 / Bspline.frm (.txt) < prev    next >
Visual Basic Form  |  1999-06-23  |  14KB  |  448 lines
  1. VERSION 5.00
  2. Begin VB.Form frmBspline 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H00C0C0C0&
  5.    Caption         =   "Bspline"
  6.    ClientHeight    =   5310
  7.    ClientLeft      =   300
  8.    ClientTop       =   555
  9.    ClientWidth     =   9150
  10.    BeginProperty Font 
  11.       Name            =   "MS Sans Serif"
  12.       Size            =   8.25
  13.       Charset         =   0
  14.       Weight          =   700
  15.       Underline       =   0   'False
  16.       Italic          =   0   'False
  17.       Strikethrough   =   0   'False
  18.    EndProperty
  19.    ForeColor       =   &H80000008&
  20.    KeyPreview      =   -1  'True
  21.    LinkTopic       =   "Form1"
  22.    PaletteMode     =   1  'UseZOrder
  23.    ScaleHeight     =   5310
  24.    ScaleWidth      =   9150
  25.    Begin VB.CheckBox chkShowControlPoints 
  26.       Caption         =   "Show Control Points"
  27.       Height          =   255
  28.       Left            =   0
  29.       TabIndex        =   11
  30.       Top             =   0
  31.       Value           =   1  'Checked
  32.       Width           =   2055
  33.    End
  34.    Begin VB.OptionButton optSurface 
  35.       Caption         =   "Spiral"
  36.       Height          =   255
  37.       Index           =   7
  38.       Left            =   0
  39.       TabIndex        =   10
  40.       Top             =   3480
  41.       Width           =   2055
  42.    End
  43.    Begin VB.OptionButton optSurface 
  44.       Caption         =   "Twist"
  45.       Height          =   255
  46.       Index           =   6
  47.       Left            =   0
  48.       TabIndex        =   9
  49.       Top             =   3120
  50.       Width           =   2055
  51.    End
  52.    Begin VB.OptionButton optSurface 
  53.       Caption         =   "Cowling"
  54.       Height          =   255
  55.       Index           =   5
  56.       Left            =   0
  57.       TabIndex        =   8
  58.       Top             =   2760
  59.       Width           =   2055
  60.    End
  61.    Begin VB.OptionButton optSurface 
  62.       Caption         =   "Pipe"
  63.       Height          =   255
  64.       Index           =   4
  65.       Left            =   0
  66.       TabIndex        =   7
  67.       Top             =   2400
  68.       Width           =   2055
  69.    End
  70.    Begin VB.OptionButton optSurface 
  71.       Caption         =   "Curl"
  72.       Height          =   255
  73.       Index           =   3
  74.       Left            =   0
  75.       TabIndex        =   6
  76.       Top             =   2040
  77.       Width           =   2055
  78.    End
  79.    Begin VB.OptionButton optSurface 
  80.       Caption         =   "Wave"
  81.       Height          =   255
  82.       Index           =   1
  83.       Left            =   0
  84.       TabIndex        =   5
  85.       Top             =   1320
  86.       Width           =   2055
  87.    End
  88.    Begin VB.OptionButton optSurface 
  89.       Caption         =   "Hill"
  90.       Height          =   255
  91.       Index           =   0
  92.       Left            =   0
  93.       TabIndex        =   4
  94.       Top             =   960
  95.       Width           =   2055
  96.    End
  97.    Begin VB.CheckBox chkShowControlGrid 
  98.       Caption         =   "Show Control Grid"
  99.       Height          =   255
  100.       Left            =   0
  101.       TabIndex        =   3
  102.       Top             =   360
  103.       Width           =   2055
  104.    End
  105.    Begin VB.OptionButton optSurface 
  106.       Caption         =   "Tent"
  107.       Height          =   255
  108.       Index           =   2
  109.       Left            =   0
  110.       TabIndex        =   2
  111.       Top             =   1680
  112.       Width           =   2055
  113.    End
  114.    Begin VB.OptionButton optSurface 
  115.       Caption         =   "Urn"
  116.       Height          =   255
  117.       Index           =   8
  118.       Left            =   0
  119.       TabIndex        =   1
  120.       Top             =   3840
  121.       Width           =   2055
  122.    End
  123.    Begin VB.PictureBox picCanvas 
  124.       AutoRedraw      =   -1  'True
  125.       Height          =   5295
  126.       Left            =   2160
  127.       ScaleHeight     =   349
  128.       ScaleMode       =   3  'Pixel
  129.       ScaleWidth      =   461
  130.       TabIndex        =   0
  131.       Top             =   0
  132.       Width           =   6975
  133.    End
  134. Attribute VB_Name = "frmBspline"
  135. Attribute VB_GlobalNameSpace = False
  136. Attribute VB_Creatable = False
  137. Attribute VB_PredeclaredId = True
  138. Attribute VB_Exposed = False
  139. Option Explicit
  140. ' Location of viewing eye.
  141. Private EyeR As Single
  142. Private EyeTheta As Single
  143. Private EyePhi As Single
  144. Private Const Dtheta = PI / 20
  145. Private Const Dphi = PI / 20
  146. Private Const Dr = 1
  147. ' Location of focus point.
  148. Private Const FocusX = 0#
  149. Private Const FocusY = 0#
  150. Private Const FocusZ = 0#
  151. Private Projector(1 To 4, 1 To 4) As Single
  152. Private TheSurface As Bspline3d
  153. Private SurfaceSelected As Integer
  154. ' Display the surface.
  155. Private Sub DrawData(pic As Object)
  156. Dim S(1 To 4, 1 To 4) As Single
  157. Dim T(1 To 4, 1 To 4) As Single
  158. Dim ST(1 To 4, 1 To 4) As Single
  159. Dim PST(1 To 4, 1 To 4) As Single
  160.     If TheSurface Is Nothing Then Exit Sub
  161.     MousePointer = vbHourglass
  162.     Refresh
  163.     ' Scale and translate so it looks OK in pixels.
  164.     m3Scale S, 35, -35, 1
  165.     m3Translate T, 230, 175, 0
  166.     m3MatMultiplyFull ST, S, T
  167.     m3MatMultiplyFull PST, Projector, ST
  168.     ' Transform the points.
  169.     TheSurface.ApplyFull PST
  170.     ' Prevent overflow errors when drawing lines
  171.     ' too far out of bounds.
  172.     On Error Resume Next
  173.     ' Display the data.
  174.     pic.Cls
  175.     TheSurface.Draw pic, EyeR
  176.     picCanvas.SetFocus
  177.     MousePointer = vbDefault
  178. End Sub
  179. ' Set the control points for an urn.
  180. Private Sub MakeUrn()
  181. Dim R(1 To 5) As Single
  182. Dim h(1 To 5) As Single
  183. Dim i As Integer
  184.     TheSurface.SetBounds 5, 6
  185.     R(1) = 0.5
  186.     R(2) = 0.5
  187.     R(3) = 2.5
  188.     R(4) = 0.75
  189.     R(5) = 0.75
  190.     h(1) = 4
  191.     h(2) = 3.5
  192.     h(3) = 2
  193.     h(4) = -1
  194.     h(5) = -3
  195.     For i = 1 To 5
  196.         TheSurface.SetControlPoint i, 1, -1.5 * R(i), h(i), 0
  197.         TheSurface.SetControlPoint i, 2, -1.5 * R(i), h(i), -1.5 * R(i)
  198.         TheSurface.SetControlPoint i, 3, 1.5 * R(i), h(i), -1.5 * R(i)
  199.         TheSurface.SetControlPoint i, 4, 1.5 * R(i), h(i), 1.5 * R(i)
  200.         TheSurface.SetControlPoint i, 5, -1.5 * R(i), h(i), 1.5 * R(i)
  201.         TheSurface.SetControlPoint i, 6, -1.5 * R(i), h(i), 0
  202.     Next i
  203. End Sub
  204. ' Set the control points for a pipe.
  205. Private Sub MakePipe()
  206. Const S = 3
  207. Dim i As Integer
  208. Dim X As Single
  209.     TheSurface.SetBounds 4, 6
  210.     For i = 1 To 4
  211.         X = 1.5 * (i - 2.5)
  212.         TheSurface.SetControlPoint i, 1, X, _
  213.             -S, 0
  214.         TheSurface.SetControlPoint i, 2, X, _
  215.             -S, -S
  216.         TheSurface.SetControlPoint i, 3, X, _
  217.             S, -S
  218.         TheSurface.SetControlPoint i, 4, X, _
  219.             S, S
  220.         TheSurface.SetControlPoint i, 5, X, _
  221.             -S, S
  222.         TheSurface.SetControlPoint i, 6, X, _
  223.             -S, 0
  224.     Next i
  225. End Sub
  226. ' Set the control points for a curl.
  227. Private Sub MakeCurl()
  228. Dim ang As Integer
  229. Dim j As Integer
  230. Dim R As Single
  231. Dim X As Single
  232. Dim Y As Single
  233. Dim Z As Single
  234.     TheSurface.SetBounds 4, 4
  235.     For j = 1 To 4
  236.         Z = 1.5 * (j - 2.5)
  237.         R = 6 - Abs(2 * j - 5)
  238.         For ang = 1 To 4
  239.             X = R * Cos((ang - 1) * PI / 2)
  240.             Y = R * Sin((ang - 1) * PI / 2)
  241.             TheSurface.SetControlPoint ang, j, X, Y, Z
  242.         Next ang
  243.     Next j
  244. End Sub
  245. ' Set the control points for a wave.
  246. Private Sub MakeWave()
  247. Dim i As Integer
  248. Dim j As Integer
  249.     TheSurface.SetBounds 4, 4
  250.     ' Start flat and modify from there.
  251.     For i = 1 To 4
  252.         For j = 1 To 4
  253.             TheSurface.SetControlPoint i, j, 2 * i - 5, 0, 2 * j - 5
  254.         Next j
  255.     Next i
  256.     ' Make the modifications.
  257.     TheSurface.SetControlPoint 2, 2, -1, -7, -1
  258.     TheSurface.SetControlPoint 2, 3, -1, 7, 1
  259.     TheSurface.SetControlPoint 3, 2, 1, -7, -1
  260.     TheSurface.SetControlPoint 3, 3, 1, 7, 1
  261. End Sub
  262. ' Set the control points for a tent.
  263. Private Sub MakeTent()
  264.     TheSurface.SetBounds 3, 3
  265.     TheSurface.SetControlPoint 1, 1, -3, -2, -3
  266.     TheSurface.SetControlPoint 1, 2, -3, 2, 0
  267.     TheSurface.SetControlPoint 1, 3, -3, -2, 3
  268.     TheSurface.SetControlPoint 2, 1, 0, 2, -3
  269.     TheSurface.SetControlPoint 2, 2, 0, 4, 0
  270.     TheSurface.SetControlPoint 2, 3, 0, 2, 3
  271.     TheSurface.SetControlPoint 3, 1, 3, -2, -3
  272.     TheSurface.SetControlPoint 3, 2, 3, 2, 0
  273.     TheSurface.SetControlPoint 3, 3, 3, -2, 3
  274. End Sub
  275. ' Set the control points for a spiral.
  276. Private Sub MakeSpiral()
  277.     TheSurface.SetBounds 5, 3
  278.     TheSurface.SetControlPoint 1, 1, -4, 2, 0
  279.     TheSurface.SetControlPoint 1, 2, -4, 0, 0
  280.     TheSurface.SetControlPoint 1, 3, -4, -2, 0
  281.     TheSurface.SetControlPoint 2, 1, -2, 0, -4
  282.     TheSurface.SetControlPoint 2, 2, -2, 0, 0
  283.     TheSurface.SetControlPoint 2, 3, -2, 0, 4
  284.     TheSurface.SetControlPoint 3, 1, 0, -4, 0
  285.     TheSurface.SetControlPoint 3, 2, 0, 0, 0
  286.     TheSurface.SetControlPoint 3, 3, 0, 4, 0
  287.     TheSurface.SetControlPoint 4, 1, 2, 0, 4
  288.     TheSurface.SetControlPoint 4, 2, 2, 0, 0
  289.     TheSurface.SetControlPoint 4, 3, 2, 0, -4
  290.     TheSurface.SetControlPoint 5, 1, 4, 2, 0
  291.     TheSurface.SetControlPoint 5, 2, 4, 0, 0
  292.     TheSurface.SetControlPoint 5, 3, 4, -2, 0
  293. End Sub
  294. ' Set the control points for a twist.
  295. Private Sub MakeTwist()
  296.     TheSurface.SetBounds 3, 3
  297.     TheSurface.SetControlPoint 1, 1, -3, 0, -3
  298.     TheSurface.SetControlPoint 1, 2, -3, 0, 0
  299.     TheSurface.SetControlPoint 1, 3, -3, 0, 3
  300.     TheSurface.SetControlPoint 2, 1, 0, -1.7, -1.7
  301.     TheSurface.SetControlPoint 2, 2, 0, 0, 0
  302.     TheSurface.SetControlPoint 2, 3, 0, 1.7, 1.7
  303.     TheSurface.SetControlPoint 3, 1, 3, -3, 0
  304.     TheSurface.SetControlPoint 3, 2, 3, 0, 0
  305.     TheSurface.SetControlPoint 3, 3, 3, 3, 0
  306. End Sub
  307. ' Set the control points for a cowling.
  308. Private Sub MakeCowl()
  309. Dim i As Integer
  310. Dim S As Single
  311. Dim Y As Single
  312.     TheSurface.SetBounds 4, 6
  313.     For i = 1 To 4
  314.         Y = 3 - 2 * Abs(i - 2.5)
  315.         
  316.         S = 2 + i / 2
  317.         
  318.         TheSurface.SetControlPoint i, 1, _
  319.             1.25 * S - 1, Y, 0
  320.         TheSurface.SetControlPoint i, 2, _
  321.             1.25 * S - 1, Y, S
  322.         TheSurface.SetControlPoint i, 3, _
  323.             -S - 1, Y, S
  324.         TheSurface.SetControlPoint i, 4, _
  325.             -S - 1, Y, -S
  326.         TheSurface.SetControlPoint i, 5, _
  327.             1.25 * S - 1, Y, -S
  328.         TheSurface.SetControlPoint i, 6, _
  329.             1.25 * S - 1, Y, 0
  330.     Next i
  331. End Sub
  332. ' Set the control points for a hill.
  333. Private Sub MakeHill()
  334. Dim i As Integer
  335. Dim j As Integer
  336.             
  337.     TheSurface.SetBounds 5, 5
  338.     ' Start flat and modify from there.
  339.     For i = 1 To 5
  340.         For j = 1 To 5
  341.             TheSurface.SetControlPoint i, j, 2 * (i - 3), 0, 2 * (j - 3)
  342.         Next j
  343.     Next i
  344.     ' Make the modifications.
  345.     TheSurface.SetControlPoint 3, 3, 0, 5, 0
  346. End Sub
  347. Private Sub Form_Resize()
  348. Dim wid As Single
  349.     wid = ScaleWidth - picCanvas.Left
  350.     If wid < 120 Then wid = 120
  351.     picCanvas.Move picCanvas.Left, 0, wid, ScaleHeight
  352. End Sub
  353. Private Sub optSurface_Click(Index As Integer)
  354.     SurfaceSelected = Index
  355.     CreateData
  356.     DrawData picCanvas
  357. End Sub
  358. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  359.     Select Case KeyCode
  360.         Case vbKeyLeft
  361.             EyeTheta = EyeTheta - Dtheta
  362.         Case vbKeyRight
  363.             EyeTheta = EyeTheta + Dtheta
  364.         Case vbKeyUp
  365.             EyePhi = EyePhi - Dphi
  366.         Case vbKeyDown
  367.             EyePhi = EyePhi + Dphi
  368.         Case Else
  369.             Exit Sub
  370.     End Select
  371.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  372.     DrawData picCanvas
  373. End Sub
  374. Private Sub Form_KeyPress(KeyAscii As Integer)
  375.     Select Case KeyAscii
  376.         Case Asc("+")
  377.             EyeR = EyeR + Dr
  378.         
  379.         Case Asc("-")
  380.             EyeR = EyeR - Dr
  381.         
  382.         Case Else
  383.             Exit Sub
  384.     End Select
  385.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  386.     DrawData picCanvas
  387. End Sub
  388. Private Sub Form_Load()
  389.     ' Initialize the eye position.
  390.     EyeR = 10
  391.     EyeTheta = PI * 0.2
  392.     EyePhi = PI * 0.1
  393.     ' Initialize the projection transformation.
  394.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  395. End Sub
  396. ' Create the surface.
  397. Private Sub CreateData()
  398. Const GapU = 0.25
  399. Const GapV = 0.25
  400. Const Du = GapU / 3
  401. Const Dv = GapV / 3
  402.     MousePointer = vbHourglass
  403.     Refresh
  404.     Set TheSurface = New Bspline3d
  405.     TheSurface.DrawControls = (chkShowControlPoints.value = vbChecked)
  406.     TheSurface.DrawGrid = (chkShowControlGrid.value = vbChecked)
  407.     ' Set the control points.
  408.     Select Case SurfaceSelected
  409.         Case 0  ' Hill.
  410.             MakeHill
  411.         Case 1  ' Wave.
  412.             MakeWave
  413.         Case 2  ' Tent.
  414.             MakeTent
  415.             
  416.         Case 3  ' Curl.
  417.             MakeCurl
  418.             
  419.         Case 4  ' Pipe.
  420.             MakePipe
  421.             
  422.         Case 5  ' Cowling.
  423.             MakeCowl
  424.             
  425.         Case 6  ' Twist.
  426.             MakeTwist
  427.         
  428.         Case 7  ' Spiral.
  429.             MakeSpiral
  430.         
  431.         Case 8  ' Urn.
  432.             MakeUrn
  433.         Case Else  ' Something safe.
  434.             MakeHill
  435.     End Select
  436.     ' Initialize the B-spline.
  437.     TheSurface.InitializeGrid 3, 3, _
  438.         GapU, GapV, Du, Dv
  439. End Sub
  440. Private Sub chkShowControlPoints_Click()
  441.     TheSurface.DrawControls = (chkShowControlPoints.value = vbChecked)
  442.     DrawData picCanvas
  443. End Sub
  444. Private Sub chkshowcontrolgrid_Click()
  445.     TheSurface.DrawGrid = (chkShowControlGrid.value = vbChecked)
  446.     DrawData picCanvas
  447. End Sub
  448.